home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / COMMUNIC / NETWORKI / 0609.ZIP / DEXCARD2.BAS < prev    next >
BASIC Source File  |  1987-01-11  |  4KB  |  107 lines
  1. 5   'DEXCARD2.BAS : Sample General Roladex Card Print Program for DEX/NET
  2. 6   'Version 1.3
  3. 10  '
  4. 12  'Use the DEX/TRACT program to extract the ASCII information
  5. 13  'format (Selection F3 or 'A' in DEX/TRACT).
  6. 14  '
  7. 15  'Original Author : V. Godin / January 1987
  8. 16  '
  9. 17  'Modifications made for selections etc by K. Nickerson
  10. 18  'January 15th, 1987
  11. 100 '
  12. 102 '* Some Set-up Activity
  13. 103 '
  14. 105 ON ERROR GOTO 1000
  15. 110 WIDTH 80 : COLOR 7,8 : X = 1
  16. 120 CLS : KEY OFF : PRINT TAB(20);"DEX/TRACT SAMPLE ROLADEX CARD PRINT PROGRAM"
  17. 130 PRINT TAB(27);" Version 1.3 January 15th 1987"
  18. 160 PRINT : PRINT "Enter DEX/TRACT (A)scii Export "
  19. 170 INPUT "File Name    ";A$
  20. 172 PRINT : INPUT "Enter Catagory to Print On ";X$
  21. 175 OPEN A$ FOR INPUT AS #2
  22. 177 LPRINT "DEXCARD2 Print Program for DEX/NET" : LPRINT
  23. 178 LPRINT "Search Catagory is : ";X$
  24. 179 Z = 2 : GOSUB 2000
  25. 180 '
  26. 181 '* Main program loop for DEXCARD2.BAS *'
  27. 182 '
  28. 183 '* Start by reading the whole 'record' into memory *'
  29. 184 '
  30. 185 INPUT #2,C$
  31. 186 IF EOF(2) THEN 275
  32. 187 INPUT #2,D$,E$,F$,G$,H$,I$,J$,K$,L$,M$,N$,O$,P$,Q$,R$,S$,T$
  33. 188 '
  34. 189 '* Check to see if either select key is equal to user supplied *'
  35. 190 '
  36. 191 '* Start by getting rid of trailing spaces for comparisson *'
  37. 192 '
  38. 197 B$ = N$ : GOSUB 700 : N$ = B$
  39. 198 B$ = O$ : GOSUB 700 : O$ = B$
  40. 199 '
  41. 200 IF X$ = "" THEN GOSUB 500 ELSE IF N$ = X$ THEN GOSUB 500 ELSE IF O$ = X$ THEN GOSUB 500
  42. 250 GOTO 185
  43. 270 '
  44. 271 '* All processing complete, close files and exit back to system *'
  45. 272 '
  46. 275 CLOSE #2
  47. 280 PRINT "End-of-Job" : BEEP : BEEP : BEEP : END
  48. 500 '
  49. 501 '* This section prints the record to the output device *'
  50. 502 '
  51. 503 '* This code was written 'this way' to be EASY as possible
  52. 504 '* to change, feel free to edit to meet your requirements!
  53. 505 '
  54. 506 '* The B$;" "; allows the next field to be on the current line    *'
  55. 507 '* The 'ELSE LPRINT' makes sure that if the field is empty,       *'
  56. 508 '*     the following field will be printed in it's correct place. *'
  57. 509 '
  58. 510 Z = 1
  59. 520 B$ = C$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Name       : ";B$;" ";: Z = Z + 1
  60. 522 B$ = D$ : GOSUB 700 : IF B$ <> "" THEN LPRINT B$ ELSE LPRINT : Z = Z + 1
  61. 524 B$ = E$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Company    : ";B$  : Z = Z + 1
  62. 526 B$ = F$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Address    : ";B$  : Z = Z + 1
  63. 528 B$ = G$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "           : ";B$;" "; : Z = Z + 1
  64. 530 B$ = H$ : GOSUB 700 : IF B$ <> "" THEN LPRINT B$ ELSE LPRINT : Z = Z + 1
  65. 532 B$ = I$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "City       : ";B$;" "; : Z = Z + 1
  66. 534 B$ = J$ : GOSUB 700 : IF B$ <> "" THEN LPRINT B$ ELSE LPRINT : Z = Z + 1
  67. 536 B$ = K$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Code       : ";B$  : Z = Z + 1
  68. 538 B$ = L$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Phone 1    : ";B$  : Z = Z + 1
  69. 540 B$ = M$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Phone 2    : ";B$  : Z = Z + 1
  70. 542 B$ = N$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Catagory 1 : ";B$ : Z = Z + 1
  71. 544 B$ = O$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Catagory 2 : ";B$ : Z = Z + 1
  72. 546 B$ = P$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Date       : ";B$ : Z = Z + 1
  73. 548 B$ = Q$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Time       : ";B$ : Z = Z + 1
  74. 550 B$ = R$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Note 1     : ";B$  : Z = Z + 1
  75. 552 B$ = S$ : GOSUB 700 : IF B$ <> "" THEN LPRINT "Note 2     : ";B$  : Z = Z + 1
  76. 598 GOSUB 2000
  77. 599 RETURN
  78. 700 '
  79. 701 '* Erase Trailing Spaces in Input Field B$ *'
  80. 702 '
  81. 710 FOR L = LEN(B$) TO 1 STEP -1
  82. 720 IF MID$(B$,L,1) <> " " THEN 740
  83. 730 NEXT L : RETURN
  84. 740  B$ = LEFT$(B$,L): RETURN
  85. 1000 '
  86. 1001 '* Printer Error Recovery *'
  87. 1002 '
  88. 1010 IF ERR=24 THEN RESUME
  89. 1020 IF ERR <> 27 AND ERR <> 25 THEN 1100
  90. 1030 PRINT : BEEP : COLOR 25,7
  91. 1040 PRINT "Turn Printer On...";:COLOR 7,8
  92. 1050 PRINT : PRINT "Hit ANY Key to Continue"
  93. 1060 IF INKEY$="" THEN 1060 ELSE RESUME
  94. 1100 ON ERROR GOTO 0 : END
  95. 2000 '
  96. 2001 '* This sub-routine generates n blank lines to next form *'
  97. 2002 '
  98. 2004 '  To alter spaces between lables change line number 2020
  99. 2006 '  in the FOR loop which will 'count' this adjustment
  100. 2007 '
  101. 2020 FOR P = Z TO 20 :'<-- CHANGE THIS LINE FOR FORM SPACES
  102. 2030 LPRINT ' '
  103. 2040 NEXT P
  104. 2050 RETURN
  105. 9000 '
  106. 9001 '* End of Program
  107.